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— Rectangles. Mesa Edited by Sandman on September 27, 1977 11:26 AM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
ControlDefs: FROM "controldef s", 
ImageDefs: FROM "imagedef s" , 
InlineDefs: FROM "inl inedef s" , 
IODefs: FROM "iodefs", 
MiscDefs: FROM "miscdefs", 
NovaOps: FROM "novaops", 
OsStaticDefs: FROM "osstaticdef s" , 
SystemDefs: FROM "systemdefs", 
SegmentDefs: FROM "segmentdefs", 
StreamDefs: FROM "s treamdef s" , 
RectangleDefs: FROM "rectangledefs" ; 

DEFINITIONS FROM InlineDefs, SystemDefs, SegmentDefs, StreamDefs, RectangleDefs; 

Rectangles: PROGRAM[pagesformap, mapwordsperl ine: CARDINAL] 

IMPORTS ImageDefs, MiscDefs, SystemDefs, SegmentDefs, StreamDefs 

EXPORTS RectangleDefs SHARES RectangleDefs = 
BEGIN 

— CHARACTER constants 

CR: CHARACTER - IODefs. CR; 
Space: CHARACTER = IODefs. SP; 
DEL: CHARACTER = IODefs. DEL; 

— GLOBAL PUBLIC Data (all PUBLIC for initialization guy ??) 

savedfirstDCB: DCBptr <- NIL; 

tempDCB: UNSPECIFIED; 

bitmaps: PUBLIC BMHandle <- NIL; 

defaultmapdata: PUBLIC BMHandle ♦- NIL; 

defaultfont: PUBLIC Fptr «- NIL; -- points to start of font 

defaultpfont: PUBLIC FAptr <- NIL; -- points to self relative ptrs 

def aul tf ontsegment : FileSegmen tHandle «• NIL; 

defaultl ineheight: PUBLIC INTEGER; -- assuming all lines equal; 

defaultcharwidths: STRING ♦• [128]; -- should be byte ARRAY (later!!) 

-- GLOBAL Data 

wordsinpage: INTEGER = Al toDefs . PageSize; 
bbtable: ARRAY [0 . . SIZE[BBTable]+l] OF WORD; 
bbptr: BBptr ♦■ LOOPHOLE[@bbtable] ; 

-- Bitmap Rectangle Routines 

CreateRectangle: PUBLIC PROCEDURE 

[bitmap: BMHandle, xO, width: xCoord, yO, height: yCoord] RETURNS[Rp tr] = 

BEGIN 

-- define locals 

rectangle: Rptr; 
-- allocate rectangle object and init it 

rectangle *- Al 1 ocateHeapNode[SIZE[Rectangle]] ; 

rectanglet <- Rectangle[NIL, FALSE,, bitmap, xO, width, 0, yO, height, 0]; 

rectangle . options «- ROptions[FALSE , FALSE] ; 
-- link it into the listof rectangles and fix it up 

rectangle. 1 ink ♦- bitmap . rectangl es ; 

bitmap . rectangl es ♦• rectangle; 

FixupRectangle[rectangle]; 

RETURN[rectangle]; 
END: 

DestroyRectangle: PUBl IC PROCfDURE [rectangle: Rptr] = 
BTGTN 

-- define locals 
prev: Rptr; 

bitmap: BMHandle ♦- rectangl e . bi tmap ; 
-- delink it from the list of rectangles 
IF b i tmap . rectangles = rectangle THEN 
b i tmap . rectangles <- rectangle . 1 ink 

n sr 

BCGIN 

prev +* b i tmap . rectangles ; 

UNTIL rectangle = prev. link DO 
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IF prev = NIL THEN ERROR; 
prev <- prev. 1 ink; 
ENDLOOP; 
prev. link «- rectangle. 1 ink; 
END; 
-- deallocate rectangle object 

FreeHeapNode[ rectangle]; 
END; 

MoveRectangle: PUBLIC PROCEDURE [rectangle: Rptr, x: xCoord, y: yCoord] = 
BEGIN 
-- define locals 

oldx: INTEGER = rectangle. xO; 
oldw: INTEGER = rectangle. cw; 
oldy: INTEGER » rectangle .yO ; 
oldh: INTEGER = rectangle. ch ; 
mapaddr: BMptr = rectangle. bitmap . addr; 
wordsperl ine: INTEGER * rectangle . bitmap .wordsperl ine ; 
dlx, dty, dh, dw: INTEGER; 
-- this is a NOP if not moved 

IF x = oldx AND y = oldy THEN RETURN; 
-- and update rectangle to reflect move 
rectangle. xO ♦- x; 
rectangle. yO <- y; 
FixupRectangle[rect angle]; 
IF rectangle. visible = FALSE THEN RETURN; 
-- ok, now physically move it 
dw «- MIN[ rectangle, cw, oldw]; 
dh «- MIN[ rectangle, ch , oldh]; 

bbptrt ♦- BBTable[0, block, replace, 0, mapaddr, wordsperl ine, x, y, dw, dh, mapaddr, wordsperline 
**, oldx, oldy, 0, 0, 0, 0]; 
BitBlt[bbptr]; 
-- now figure out what was left behind and clear it 
IF x # oldx THEN -- first check if moved in x 
BEGIN 

IF x > oldx THEN 
BEGIN 

dlx ♦• oldx; 

dw «- MIN[x-oldx, oldw]; 
END 
ELSE 
BEGIN 

dlx ♦- MAX[oldx, x+MIN[rectangle.cw, oldw]]; 
dw *■ (oldx+oldw) - dlx; 
END; 
dty ♦- oldy; 
dh «• oldh; 

bbptrt ♦• BBTable[, gray, replace,,,, dlx, dty, dw, dh ,,,]; 

Bi tBl t[bbptr] ; 
END; 
IF y U oldy THEN -- now see if moved in y 
BEGIN 

IF y > oldy THEN 
BEGIN 

dty ♦• oldy; 

dh <- MIN[y-oldy, oldh]; 
END 
ELSE 
BEGIN 

dty ♦■ MAX[oldy, y+MIN[ rectangle . ch , oldh]]; 
dh *- (oldy+oldh)-dty; 
END; 
dlx «- oldx ; 
dw ♦- oldw; 

bbptr^ ♦- BBTable[, gray, replace,,,, dlx, dty, dw, dh ]; 

Bi tBU[bbptr]; 
FND; 
TND; 

GrowRectangle: PUBl TC PROCTDURr [rectangle: Rptr, width: xCoord, height: yCoord] = 
BfGTN 
-- define locals 

mapaddr: BMptr = rec tang 1 e . b i tmap . addr ; 

wordsperline: INTrGTR = rec tangle . b i tmap .wordsperl ine ; 

clearwords: GrayArray «- [0, 0, 0, 0]; 

graywords: GrayArray ♦■ [125252B, 52525B, 125252B, 52525B]; 
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clear: GrayPtr * Qclearwords; 

gray: GrayPtr a Qgraywords; 
— if it did not change then ignore 

IF width = rectangle. width 

AND height = rectangle. height THEN RETURN; 
-- clear it, change it, and then paint it gray 

ClearBoxInRectangle[rectangle, 0, rectangle. cw, 0, rectangle. ch, clear]; 

rectangle. width «- width; 

rectangle. height «- height; 

FixupRectangle[ rectangle] ; 

ClearBoxInRectangle[rectangle, 0, rectangle. cw, 0, rectangle. ch, gray]; 
RETURN; 
END; 

ClearBoxInRectangle: PUBLIC PROCEDURE 

[rectangle: Rptr, xO, width: xCoord, yO, height: yCoord, gray: GrayPtr] ■ 

BEGIN 

-- declare locals 

mapaddr: BMptr «- rectangle. bitmap . addr; 

wordsperl ine: INTEGER = rectangle .bitmap .wordsperl ine; 

dlx: INTEGER ♦• rectangl e . xO+xO ; 

dty: INTEGER <- rectangle .yO+yO ; 

dw: INTEGER <- MIN[rectangle . cw, width]; 

dh: INTEGER «- MIN[rectangle . ch , height]; 
-- construct a BITBLT table and clear it 

bbptr? ♦• BBTable[0, gray, replace, 0, mapaddr, 

wordsperl ine, dlx, dty, dw, dh, mapaddr, wordsperl ine, 

dlx, dty, gray*[0], gray?[l], grayt[2], gray?[3]]; 

BitBlt[bbptr]; 
END; 

DrawBoxInRectangle: PUBLIC PROCEDURE 

[rectangle: Rptr, xO, width: xCoord, yO , height: yCoord] = 

BEGIN 

-- declare locals 

mapaddr: BMptr «- rectangle. bitmap . addr ; 

wordsperl ine: INTEGER = rectangl e . bitmap .wordspe p l ine; 

dlx: INTEGER «- rectangle . xO+xO ; 

dty: INTEGER ♦• rectangle . yO+yO ; 

dw: INTEGER ♦• MIN[rectangl e . cw, width]; 

dh: INTEGER ♦• MIN[rectangle . ch , height]; 
-- draw the top 1 ine; 

bbptrt «- BBTable[0, gray, replace, 0, mapaddr, 

wordsperl ine , dlx, dty, dw, 1, mapaddr, wordsperl ine, 

dlx, dty, -1, -1, -1, -1]; 

BitBlt[bbptr]; 
-- draw two sides; 

bbptr? <- BBTable[, gray,,,,,,, 1, dh, ,,,,,,,]; 

BitBlt[bbptr]; 

bbptrt <- BBTable[ , dlx+dw-1, dty, 1, dh,, ]; 

BitBl t[bbptr]; 
-- and the bottom 

bbptrt <- BBTable[ dlx, dty+dh-1, dw, 1,,,,,,,,]; 

BUBlt[bbptr]; 
END; 

InvertBoxInRectangle: PUBLIC PROCEDURE 

[rectangle: Rptr, xO, width: xCoord, yO , height: yCoord] = 

BEGIN 

-- declare locals 

mapaddr: BMptr <- rectangle, bi tmap . addr ; 

wordsperl ine: INTEGER = rectangle. b i tmap .wordsperl ine; 

dlx: INTEGER ♦- rectang le . xO+xO ; 

dty: INTEGFR <- rectangl e . yO+yO ; 

dw: INTEGER ♦- MIN[rec tangl e . cw , width]; 

dh: INTEGER <- MIN[rectangle . ch , height]; 
- - invert it 

bbptrt <- BBTable[0. compliment, replace, 0, mapaddr, 

wordsperl ine , dlx, dty, dw, dh, mapaddr, wordsperl ine , 

dlx, dty, , , .]; 

BitBl t[bbptr]; 
FND; 

ScrollBoxTnRectangle: PUBI IC PROCEDURE 

[rectangle: Rptr, xO, width: xCoord, yO , height: yCoord, incr: INTEGER] = 
BEGIN 
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— declare locals 

mapaddr: BMptr «- rectangle. bitmap .addr; 

wordsperl ine: CARDINAL * rectangle. bitmap. wordsperl ine; 

dlx: INTEGER «- rectangle .xO+xQ; 

dw: INTEGER <- MIN[rectangle. cw , width]; 

dh: INTEGER ♦- MIN[rectangle. ch , (height-incr)]; 

dty: INTEGER; 

sty: INTEGER; 

— decide which way to scroll 
IF incr > THEN 

BEGIN 

dty <- rectangle. yO+yO; 

sty <- dty+incr; 

END 
ELSE 

BEGIN 

sty «• rectangle. yO+yO; 

dty ♦• sty+incr; 

END; 
-- move it all up/down the specified amount 

bbptrt +■ BBTable[0, block, replace, 0, mapaddr, 
wordsperl ine, dlx, dty, dw, dh, mapaddr, wordsperl ine, 
dlx, sty, , , , ] ; 
BitBlt[bbptr]; 
END; 

FixupRectangle: PROCEDURE[rectangle: Rptr] = 
BEGIN 

-- check if all ok first 
IF rectangle. bitmap 3 NIL 

OR rectangle. bitmap. addr = NIL THEN 
BEGIN 

rectangle. visible ♦• FALSE; 
RETURN; 
END; 
-- check for clipping on the right 

IF rectangle . xO+rectangle. width > rectangl e. bitmap .width THEN 

rectangle. cw <- MAX[0, rectangle. bitmap .w id th-rectangl e . xO] 
ELSE 

rectangle. cw <- rectangle. width; 
-- check for clipping on the bottom 

IF rectangle. yO+rectangle. height > rectangle .bitmap. height THEN 

rectangle. ch <- MAX[0, rectangle, bitmap, height-rectangle .yO] 
ELSE 

rectangle. ch <- rectangle, height; 
-- now check if visible 

IF rectangle. xO+minwidth > rectangle. bi tmap .width OR 
rectangle. yO+minheight > rectangle. bi tmap . height THEN 
rectangle, visible «- FALSE 
ELSE 

rectangle, vis ible ♦- TRUE; 
END; 

WriteRectangleChar: PUBLIC PROCEDURE 

[rectangle: Rptr, x: xCoord, y: yCoord, char: CHARACTER, pfont: FAptr] 
RETURNS[xCoord, yCoord] = 

-- Note: funny ywordoffset due to use of CONVERT!!! 
BEGIN 

-- define locals and init them 
dba: INTEGER; 
wad: BMptr; 
cwidth: xCoord; 

wordsperl ine: INTEGER = rectangle . bitmap .wordsperl ine; 
xoffset: xCoord; 

ywordoffset: INTrGER = ( rectangle . yO + y - 1 )*wordsperl ine; 
-- following is awful, undo later signed: Smokey 
1 ineheight: TNrrGFR = I.OOP!IOI.E[(pfont-Sl7C[FontHeader]) t[0]]; 
-- compute (or get char width) 

IT pfont = defaultpfont AND char <= DFL THEN 

cwidth ♦- LOOPI!OLE[defaul tcharw id ths[L 00PII0L E[ char , CARDINAL]] , xCoord] 
Fl.SE 

cwidth «- ComputeCharWidth[char, pfont]; 
-- check for rectangle is visible and overflow 
TT rectangle. v is ible = FAl ST THEN 

TF rectangle . op t ions . Notelnv is ible THEN 

SIGNAI Rec tanglefrror[rec tangle, NotVisible] 
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ELSE RETURN[x, y] ; 
IF y+1 ineheight >= rectangle. ch THEN 
IF rectangle. options. NoteOverflow THEN 

SIGNAL Rectangl eE r ro r[ r ec tangle, Bo ttomOver flow] 
ELSE RETURN[x, y] ; 
IF x+cwidth > rectangle. cw THEN 

IF rectangle. options .NoteOverflow THEN 

SIGNAL RectangleError[rectangle, RightOverf low] 
ELSE RETURN[x, y]; 
-- compute some more stuff 
xoffset «- rectangle. xO + x; 
dba ♦■ BITAND[BITNOT[xoffset], 17B]j 
wad ♦• rectangle. bitmap . addr+(xoffset/16)+ywordoff set; 
-- do scan convert 

[cwidth, dba, wad] «- CONVERT[char , pfont, wad, wordsperl ine, dba] ; 
RETURN[x+cwidth, y]; 
END; 

WriteRectangleString: PUBLIC PROCEDURE 

[rectangle: Rptr, x: xCoord, y: yCoord, str: STRING, pfont: FAptr] 
RETURNS[xCoord, yCoord] * 
BEGIN 

-- define locals 
i: INTEGER; 

length: INTEGER = str. length; 
-- for now call write character (make faster later!) 
FOR i IN [0. .length) DO 

[x, y] <- WriteRectangleChar[rectangle, x, y, str[i], pfont]; 
ENDLOOP; 
RETURN[x,y] 
END; 

RectangleToMapCoords: PUBLIC PROCEDURE [rectangle: Rptr, x: xCoord, y: yCoord] 
RETURNS[mapx: xCoord, mapy: yCoord] = 
BEGIN 
-- compute it 

mapx «- rectangle. xO + MAX[0, MIN[rectangle. cw, x]]; 

mapy <- rectangle. yO + MAX[0, MIN[rectangle . ch, y]]; 
RETURN[mapx, mapy] 
END; 

RectangleError: PUBLIC SIGNAL [rectangle: Rptr, error: RectangleErrorCode] = CODE; 

-- Bitmap Routines 

GetDefaultBitmap: PUBLIC PROCEDURE RETURNS [BMHandle] = 
BEGIN 

RETURN[defaultmapdata]; 
END; 

EVEN: PROCEDURE[v: UNSPECIFIED] RETURNS [UNSPECIFIED] = 
BEGIN 

-- make an even value by rounding v up 
RETURN[v+BITAND[v, 1]]; 
END; 

CreateBitmap: PUBLIC PROCEDURE [pagesf ormap , wordsperl i ne : CARDINAL] RETURNS[BMHandle] = 
BEGIN 
-- define locals 

mapdata: BMHandle; 

deb: DCBptr; 
-- now allocate bitmap data records and init it 

mapdata «- AllocateHeapNode[SIZr[Bi tmapOb ject]] ; 

mapdatat ♦- B i tmapOb jec L[NIL , NIL, NIL, NIL, 0, 0, 0, 0, 0, C, 0, high, white]; 
-- allocate a deb for this guy 

-- N0TT: lots'a funnies because DCB's must be even 

-- and someone has to deallocate him eventually!!) 

deb *- rvrN[mapdata.dcb - Al localeHeapNode[SI7r[DCB] + l]] ; 

deb. next ♦- DCBnil ; 

Real locaLeB i tmap[mapda ta. pagesformap . wordsperl ine] ; 
-- put him in the list of all bitmaps 

mapdata. link ♦- bitmaps; 

b i tmaps «- mapdata; 

RL"TURN[mapdata]; 
fND; 
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DestroyBitmap: PUBLIC PROCEDURE[mapdata: BMHandle] RETURNS [POINTER] > 
BEGIN 
-- define locals 

addr: POINTER; 

prev: BMHandle; 

— check to see if all Rectangles are gone 
IF mapdata. rectangles ft NIL THEN 

SIGNAL 8itmapError[mapdata, BitmapOperation] ; 
-- now actually destroy it 

IF mapdata. addr ft NIL THEN FreePages[mapdata. addr] ; 
IF mapdata. deb ft NIL THEN FreeHeapNode[mapdata. deb]; 
addr ♦• mapdata. addr; 
-- take it out of the list of bitmaps 
IF mapdata = bitmaps THEN 

bitmaps «-mapdata. 1 ink 
ELSE 
BEGIN 

prev «- bitmaps; 
UNTIL mapdata - prev. link DO 
IF prev = NIL THEN ERROR; 
prev <- prev. 1 ink; 
ENDLOOP; 
prev. link ♦• mapdata. 1 ink; 
END; 
FreeHeapNode[mapdata]; 
RETURN[addr]; 
END; 

UpdateBitmap: PUBLIC PROCEDURE [mapdata: BMHandle] RETURNS [DCBptr] = 
BEGIN 
-~ reflects any changes in the bitmap object in the hardware 

— define locals 

deb: DCBptr = EVEN[mapdata. deb] ; 
-- now fix up the DCB 

deb. bitmap «- mapdata. addr; 

deb. height «- mapdata. height/2; 

deb. width <- mapdata. wordsperl ine; 

deb . indenting ♦- mapdata. indenting; 

deb . resol ution *• mapdata. resolution; 

deb . background <- mapdata. background; 

RETURN[dcb]; 
END; 

ReallocateBitmap: PUBLIC PROCEDURE 

[mapdata: BMHandle, pagesformap, wordsperl ine: CARDINAL] = 

BEGIN 

-- physically alters a display bitmap 

-- define locals 

map: BMptr ♦• mapdata . addr ; 
rectangle: Rptr; 

wordsformap: CARDINAL = pagesformap*Al toDef s . PageS ize ; 
-- check if need to discard old one 

IF mapdata. addr ft NIL AND wordsformap ft mapdata. words THEN 
BEGIN 

mapdata . deb .width «- 0; -- ensure no trash on screen 
FreePages [mapdata. addr] ; 
map <- NIL; 
END; 
-- now setup and clear the new map 
IF pagesformap ft THEN 
BEGIN 

-- NOTE: assumes pages allocated on EVEN word boundary 
IF map = NIL THEN 

map «- Al locatePages[pagesformap] ; 
MiscDefs.7ero[map, wordsformap] ; 
mapdata . addr «- map ; 
mapdata. words ♦- wordsformap; 
mapdata . wordsperl i ne «- wordsperl ine ; 
mapdata .w id th ♦- wordsperl ine* 16; 
mapdata. he ight ♦- words formap/wordsper 1 i ne; 
IT BITAND[mapdata. height, 1] = 1 THEN 

mapdata. he ight ♦- mapdata. he ight-1 ; 
[] ♦- UpdateB i tmap[mapdata] ; 
FND 

risr 

BEGIN 
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mapdata.addr ♦• NIL; 

mapdata. width 4- 0; 

mapdata. height «• 0; 

END; 
-- now go setup all the streams for this map 
rectangle «- mapdata. rectangles; 
UNTIL rectangle = NIL 00 

FixupRectangle[rec tangle]; 

rectangle «- rectangle. 1 ink 

ENDLOOP; 
END; 

DisplayBitmap: PUBLIC PROCEDURE [mapdata: BMHandle] ■ 
BEGIN 
-- links a bitmap into the displaychain using a BitmapObject 

— Assumes Bitmap Record is correct 

-- eg: map is even word alligned etc... 
-- fills in the xO.yO fields in the bitmap record tool 

— define locals 

deb, nextdeb: DCBptr; 
-- ensure DCB is correct 

deb ♦- UpdateBi tmap[mapdata] ; 
-- now link into display 

nextdeb «- DCBchainHead.next; 
mapdata. yO «- 0; 
IF nextdeb DCBnil THEN 
BEGIN 
WHILE nextdeb. next if DCBnil DO 

mapdata. yO «- mapdata. yO + (nextdeb . height)*2; 
nextdeb <- nextdeb .next; 
ENDLOOP; 
mapdata. yO ♦• mapdata. yO + (nextdeb. height)*2; 
END; 
nextdeb. next <- deb; 
mapdata. xO <- mapdata. indenting*16; 
END; 

UnDisplayBitmap: PUBLIC PROCEDURE[mapdata: BMHandle] « 
BEGIN 

— nop for now 
END; 

CursorToMapCoords: PUBLIC PROCEDURE [mapdata: BMHandle, x: xCoord, y: yCoord] 
RETURNS[mapx: xCoord, mapy: yCoord] s 
BEGIN 

-- NOTE!! if bitmap ptr not supplied then use system default... 
IF mapdata * NIL THEN 

mapdata «- def aultmapdata; 
-- compute it 

mapx <- MAX[0, MIN[mapdata .width , x - mapdata. xO]] ; 

mapy «- MAX[0, MIN[mapdata. height , y - mapdata. yO]] ; 
RETURN[mapx, mapy] 
END; 

CursorToRecCoords: PUBLIC PROCEDURE [rectangle: Rptr, x: xCoord, y: yCoord] 
RETURNS[xCoord, yCoord] = 
BEGIN 
-- define locals 

rx : xCoord; 

ry : yCoord; 
-- convert cursor coordinates to window coordinates 

rx «- x - ( rectangle. xO + rectangle, bi tmap. xO) ; 

r Y «" y ~ ( rectangle. yO + rectangle, bi tmap .yO) ; 

RETURN[rx, ry]; 
END; 

BitmapCrror: PUBLIC SIGNAL [bitmap: BMHandle, error: B i tmapErrorCode] = CODE; 

-- Global Display On/Off Routines 

DisplayOn: PUB1 IC PROCEDURE = 
BEGIN 
-- locals 

ds: D isp lay Handle; 

mapdata: BMHandle <- bitmaps; 

newpf ontaddr : TAptr; 
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-- reallocate the display bitmaps 

-- NOTE: this code relies on the fields "words" and 
-- "wordsperl ine" in the BitmapObject being valid 
UNTIL mapdata = NIL DO 

ReallocateBitmap[mapdata, map data. words/256, map data. wordsperl ine]; 
mapdata <- mapdata. 1 ink; 
ENOLOOP; 
-- get default font back and fix up users of same 
Swap I n[ default font segment]; 



defaultfont ♦• FileSegmentAddress[defaultfontsegment]; 
newpfontaddr ♦• LO0PH0LE[@def aul tfont. FCDptrs , FAptr]; 
ds «- StreamDefs.GetDisplayStreamList[]; 



WHILE ds # NIL DO 

IF ds.pfont = defaultpfont THEN 

ds.pfont «- newpfontaddr; 
ds «- ds . 1 ink; 
ENDLOOP; 
defaultpfont «- newpfontaddr; 
— now really turn it on 

DCBchainHead.next ♦* savedf irstDCB; 
FreeHeapNode[tempDCB]; 
END; 

DisplayOff: PUBLIC PROCEDURE [background: backgtype] = 
BEGIN 
-- locals 

mapdata: BMHandle «- bitmaps; 

deb: DCBptr; 
-- first really turn it off 

savedfirstDCB «- DCBchainHead.next; 

tempDCB «- AllocateHeapNode[SIZE[DCB] + l] ; 

deb ♦• EVEN[tempDCB]; 

MiscDefs.Zero[dcb, SIZE[DCB]]; 

deb .background ♦■ background; 

deb . resol ution «- high; 

DCBchainHead.next «- deb; 
-- deallocate the display bitmap space 

-- NOTE: Turn ON code relies on the fields "words" and 

-- "wordsperl ine" in the BitmapObject being valid 

UNTIL mapdata = NIL DO 

Real locateBi tmap[mapdata, 0, 0]; 
mapdata <- mapdata. 1 ink; 
ENDLOOP; 
-- swapout the default font segment 

Unlock[def aul tf ontsegment]; 

SwapOut[ default font segment] ; 
END; 

- Font Stuff 

ComputeCharWidth: PUBLIC PROCEDURE [char: CHARACTER, font: POINTER] RETURNS [CARDINAL] 
BEGIN 

-- define and setup locals 
w: INTEGER ♦• 0; 
code: CARDINAL; 
cw: FCDptr; 

temp: UNSPECIFIED; -- because FCDptr's are self relative 
fontdesc: DESCRIPTOR FOR ARRAY OF FCDptr 
- DESCRIPTOR[font, 256]; 
-- checkfor control characters 
IF char = CR THEN char ♦• Space; 
IF char < Space THEN 

RrTURN[ComputeCharWidth[ , t, font] + 
Compu teCharWid th[ 

100PH0I E[lOOPHOLC[char, INTEGER ]+100B, CHARACTER] , font]]; 
-- check if default guy 
code «- IOOPHOI E[char]; 
Tf font = defaultpfont AND char <= DEL THEN 

RFTURN[I OOPHOl rfdefaul tcharw idths[l OOPHOt E [ char , CARDINAL]] , CARDINAL]] 
FLSr -- now compute the width of this character 
DO 

temp «- font + I.OOPHOl F[code .CARDINAI ] ; 

cw <- IOOPHOI F[fontdesc[l OOPHOt f"[code. CARDINAL ]] + temp , FCDptr]; 

If cw.HasNoExtension THTN f'XTT; 

w «- w+ 16 ; 

code <- cw. w id thORex t ; 
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ENDLOOP; 
RETURN [w + cw.widthORext]; 
END; 

GetDefauUFont: PUBLIC PROCEDURE RETURNS [FAptr, CARDINAL] = 
BEGIN 

RETURN[def aul tpfont, defaultl ineheight] ; 
END; 

GetFont: PUBLIC PROCEDURE [filename: STRING] RETURNS [FileSegmentHandle] = 
BEGIN 
RETURN[ 

NewFileSegment[NewFile[filename, Read, OldFileOnly], DefaultBase, DefaultPages, Read]]; 
END; 

LoadFont: PUBLIC PROCEDURE [segment: FileSegmentHandle] RETURNS [Fptr] = 
BEGIN 

Swapln[segment] ; 

RETURN[FileSegmentAddress[ segment]]; 
END; 

-- BitBlt Interface 

BitBlt: PUBLIC PROCEDURE [ptr: BBptr] * 
BEGIN 

HardwareBitBlt[ptr] 
END; 

— Mesa System Bitmap Initialization Routine 

initbitmap: PROCEDURE[pagesformap , mapwordsperl ine : CARDINAL] = 
BEGIN 

-- Declare Locals 
deb: DCBptr; 
mapdata: BMHandle; 
-- setup BitBlt table for all to use 

-- BBTables must be on even word boundaries!! 
bbptr <- EVEN[bbptr]; 
-- setup font stuff 

defaultfont ♦• LoadFont[def aul tfontsegment] ; 
defaultl ineheight <- def aul tfont . FHeader .MaxHeight; 
SetUpCharWidths[]; 
-- setup dummy spacing if at top of screen 
IF DCBchainHead.next = DCBnil THEN 
BEGIN 

-- assumes dummy deb will never deallocated 
deb <- EVEN[AllocateHeapNode[SIZE[DCB]+l]]; 
MiscDefs.Zero[dcb, SIZE[DCB]]; 
deb . background *■ white; 
deb . resolution <- high; 

deb. height *- bl ankl ines*def aul tl ineheight/2; 
DCBchainHead.next <~ deb; 
END; 
-- allocate and clear space for the system default Bitmap 

mapdata <- CreateBi tmap[pagesformap , mapwordsperl ine] ; 
-- indent the bitmap 3 words 

mapdata. indenting «- 3; 
-- link it and make it the system default 
Displ ayBitmpp [mapdata] ; 
def aul tmapdata ♦■ mapdata; 
END; 

SetUpCharWidths: PROCEDURE^ 
BEGIN 

i: INTEGER; 

pfont: TAptr *- LOOPHOI E[@def aul tf on t . TCDptrs , FAptr]; 

defaul tcharwidths . length ♦- 128; 

def aul tpfont «- NIL; 

TOR i IN [0. . 128) DO 

-- NOK : Compu teCharWidth counts on the fact 
-- "defaul tpfont" is NIL at this time 
def aul tcharwid ths[ i ] ♦• 

LO0PH0t.r[ComputeCharWidth[L00PH0LF[i.CHARACTrR], pfont] .CHARACTER]; 
CNDLOOP; 
defaultpfont «- pfont; 
END; 
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PatchUpLineHeight: PROCEDURE ■ 
BEGIN ds: Displ ayHandle; 

defaul tl ineheight «• defaultfont. FHeader .MaxHeight ; 

FOR ds «• StreamDefs.GetDisplayStreamList[], ds.link UNTIL ds = NIL DO 
IF ds.pfont = defauUpfont THEN 
BEGIN 

ds . 1 ineheight «• defaul tl ineheight; 
SetDisplayLine[ds, 1, leftmargin]; 
END; 
ENDLOOP; 
RETURN 
END; 

Cleanupltem: ImageDefs .Cleanupltem ♦* ImageDefs. Cleanupltem[ , CleanupRectangles] ; 

CleanupRectangles: ImageDefs .CleanupProcedure s 
BEGIN 
SELECT why FROM 

Finish, Abort => DCBchainHead . next ♦• DCBnil; 
Save => 
BEGIN 

DisplayOff[black]; 

DeleteFi leSegmen t[ defaul tf on t segment] ; 
mesapreopen . fi le «- NIL; 
syspreopen . f i le «- NIL; 
ImageDefs .AddFi leReques t[@me sap reopen] ; 
ImageDefs .AddFi leReques t[@sysp reopen] ; 
END; 
Restore => 
BEGIN 

InitFontFile[]; 
DisplayOn[]; 
SetUpCharWidths[]; 
PatchUpLineHeight[]; 
END; 
ENDCASE; 
RETURN 
END; 

InitFontFile: PROCEDURE = 
BEGIN 

IF syspreopen. file = NIL THEN ERROR; 
defaul tfontsegment <- NewFi 1 eSegment[ 

IF mesapreopen . file # NIL THEN mesapreopen . fi le ELSE syspreopen . file, 

DefaultBase, Defaul tPages , Read]; 
IF mesapreopen. file # NIL THEN ReleaseFi le[syspreopen . f ile] ; 
END; 

— MAIN BODY CODE 

-- make file request on second START 

mesapreopen: short ImageDefs . F ileRequest «- ImageDefs . Fi leRequest [ 

file: NIL, access: Read, link:, 

body: short[fill:, name: "MesaFont. Al . "]] ; 
syspreopen: short ImageDefs . F i leRequest +* ImageDefs . Fi leRequest [ 

file: NIL, access: Read, link:, 

body: short[fill:, name: "SysFont . Al . "]] ; 

IF (RFGISTFR[ControlDefs.SDreg]+ControlDefs.sAddFileRequest)t ff THEN 
BEGIN 

ImageDefs .AddFi leReques t[@me sap reopen] ; 
ImageDefs . Adc1FileRequest[@syspreopen]; 
STOP; 
END; 

IF mesapreopen. file = NIL THEN 

mesapreopen . f i 1 e «- NewT i le[mesapreopen . name , Read, Defaul tVers ion 
! M leNameError, MleCrror => CONTINUE]; 
IF syspreopen. file = NIL THFN 

syspreopen . f i le <- NewF i 1 e[syspreopen . name , Read, Defaul tVers ion 
! r ileNamerrror. FileCrror => CONTINUE]; 

-- now real ly do it 
In i tFon LF i le[] ; 
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initbitmap[pagesformap f mapwordsperl ine] ; 
ImageDefs. AddC lean up Procedure[QC1eanup Item] 



END. of Rectangles 



